module Zeno.Type where

import Prelude ()
import StdImports

data Type a 
  = Type !a
  | Func !(Type a) !(Type a)
  | Error
  deriving ( Eq, Ord )
  
instance NFData a => NFData (Type a) where
  rnf Error = ()
  rnf (Type a) = rnf a
  rnf (Func t1 t2) = rnf t1 `seq` rnf t2

unflattenType :: [Type a] -> Type a
unflattenType [] = Error
unflattenType xs = foldr1 Func xs

fromType :: Type a -> a
fromType (Type a) = a

simpleType :: Type a -> Bool
simpleType (Type _) = True
simpleType _ = False 

flattenType :: Type a -> [Type a]
flattenType (Func f a) = f : flattenType a
flattenType t = [t]

functionType :: Type a -> Bool
functionType (Func _ _) = True
functionType _ = False

errorType :: Type a -> Bool
errorType Error = True
errorType _ = False

instance Functor Type where
  fmap f (Type x) = Type (f x)
  fmap f (Func t1 t2) = Func (fmap f t1) (fmap f t2)
  
instance Foldable Type where
  foldMap f (Type x) = f x
  foldMap f (Func t1 t2) = foldMap f t1 `mappend` foldMap f t2
  
instance Traversable Type where
  sequenceA (Type x) = Type <$> x
  sequenceA (Func t1 t2) = Func <$> sequenceA t1 <*> sequenceA t2

instance Show a => Show (Type a) where
  show (Type id) = show id
  show (Func arg res) = 
    show_arg ++ " -> " ++ show res
    where 
      show_arg = 
        case arg of 
          Func _ _ -> "(" ++ show arg ++ ")"
          _ -> show arg
